home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Tele / M / MACPOINT Folder / MacPoint info / HexPixReader < prev    next >
Encoding:
Text File  |  1989-10-31  |  2.6 KB  |  95 lines  |  [TEXT/MACA]
  1. 'example of MacPoint "HexPix" protocol for transmitting
  2. 'bitmapped graphics in BBS messages by converting
  3. 'hexadecimal character strings to bitmaps
  4.  
  5. 'written for the Microsoft Macintosh BASIC compiler
  6.  
  7. 'bug: the last line of bits sometimes gets drawn twice
  8.  
  9. DIM STATIC H$(99), ARC$(40)
  10. DEFINT W-Z
  11. wcorner=450: wcenter=INT(wcorner/2)
  12. ARN=1
  13.  
  14. WINDOW 1, "HexPixReader", (25,35)-(250,250),1
  15. CLS: PRINT "open the bitmap file"
  16. FIN$=FILES$(1, "TEXT")
  17. OPEN FIN$ FOR INPUT AS #1
  18. WHILE NOT EOF(1)
  19.  IF ARN<40 THEN LINE INPUT #1, ARC$(ARN): ARN=ARN+1
  20. WEND
  21.  
  22. BMHeader:
  23.  NOC$="": XLIMIT$="": YLIMIT$=""
  24.  EIBM=0 'Errors In BitMap
  25.  LED=INSTR(ARC$(1), ":"): RED=INSTR(ARC$(1), "_^")
  26.  IF RED<=LED THEN PRINT "Error 1 in bitmap": BEEP: EIBM=1
  27.  FOR L=LED+1 TO RED
  28.   NOC$=NOC$+MID$(ARC$(1),L,1)
  29.   IF MID$(ARC$(1),L,1)="," THEN COMMALOC=L: L=RED+1
  30.  NEXT
  31.  NUMCOLORS=VAL(NOC$)
  32.  IF NUMCOLORS<>2 THEN PRINT "Error 2 in bitmap": BEEP: EIBM=EIBM+2
  33.  
  34.  FOR L=COMMALOC+1 TO RED
  35.   XLIMIT$=XLIMIT$+MID$(ARC$(1),L,1)
  36.   IF MID$(ARC$(1),L,1)="," THEN COMMALOC=L: L=RED+1
  37.  NEXT
  38.  XLIMIT=VAL(XLIMIT$)
  39.  IF XLIMIT/4<>INT(XLIMIT/4) THEN PRINT "Error 3 in bitmap": BEEP: EIBM=EIBM+4
  40.  IF XLIMIT<4 OR XLIMIT>300 THEN PRINT "Error 4 in bitmap": BEEP: EIBM=EIBM+8
  41.  PRINT XLIMIT "pixels wide"
  42.  
  43.  FOR L=COMMALOC+1 TO RED
  44.   YLIMIT$=YLIMIT$+MID$(ARC$(1),L,1)
  45.   IF MID$(ARC$(1),L,1)="," THEN COMMALOC=L: L=RED+1
  46.  NEXT
  47.  YLIMIT=VAL(YLIMIT$)
  48.  IF YLIMIT<4 OR YLIMIT>200 THEN PRINT "Error 5 in bitmap": BEEP: EIBM=EIBM+16
  49.  PRINT YLIMIT "pixels high"
  50.  
  51. HSC=1: ARN=2: FIRSTARN=2
  52. EXPECTEDLENGTH=XLIMIT/4
  53. NP=XLIMIT*YLIMIT: LW=INT(NP/500)
  54. PRINT "wait" LW "seconds..."
  55. PRINT: PRINT "enter a command-period to abort"
  56.  
  57. 'scan each line of message and extract hex strings, ignoring
  58. ' spaces and non-hex characters
  59.  
  60. PullMyStrings:
  61. FOR Z=1 TO LEN(ARC$(ARN))
  62.  X$=MID$(ARC$(ARN),Z,1): AX=ASC(X$+CHR$(0))
  63.  IF AX>47 AND AX<58 THEN H$(HSC)=H$(HSC)+X$
  64.  IF AX>64 AND AX<71 THEN H$(HSC)=H$(HSC)+X$
  65.  IF LEN(H$(HSC))=EXPECTEDLENGTH THEN HSC=HSC+1
  66. NEXT Z
  67. IF INSTR(ARC$(ARN), "^_bitmap,end_^")=0 AND HSC<=YLIMIT THEN ARN=ARN+1: GOTO PullMyStrings
  68.  
  69. 'dimensions for the window in which the graphic appears
  70.  
  71. Y1=25 'upper
  72. Y2=Y1+YLIMIT+3 'lower
  73. X1=wcorner-XLIMIT-7 'left
  74. X2=wcorner-1
  75.  
  76. WINDOW CLOSE 2
  77.  
  78. WINDOW 2,"",(X1,Y1)-(X2,Y2),3: CLS
  79.  
  80. 'draw the picture
  81.  
  82. FOR Y=1 TO HSC: X=2
  83.  FOR K=1 TO EXPECTEDLENGTH
  84.   HEXCHAR$=MID$(H$(Y), K, 1)
  85.   AHC=ASC(HEXCHAR$)
  86.   IF AHC>47 AND AHC<58 THEN NYBBLE=AHC-48
  87.   IF AHC>64 AND AHC<71 THEN NYBBLE=AHC-55
  88.   X=X+1: IF NYBBLE AND 8 THEN PSET(X,Y), 33
  89.   X=X+1: IF NYBBLE AND 4 THEN PSET(X,Y), 33
  90.   X=X+1: IF NYBBLE AND 2 THEN PSET(X,Y), 33
  91.   X=X+1: IF NYBBLE AND 1 THEN PSET(X,Y), 33
  92.  NEXT K
  93. NEXT Y
  94.  
  95. Loop: GOTO Loop